perm filename FATAL[G,BGB] blob
sn#051793 filedate 1973-07-05 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
RECORD PAGE DESCRIPTION
00001 00001 VALID 00010 PAGES
00002 00002 TITLE FATAL
00004 00003 INITIALIZE APR TRAP
00006 00004 PRINT BACKTRACE
00010 00005 WHAT USER CAN DO ABOUT ERROR
00012 00006 WE GET HERE ON AT INTERRUPT
00015 00007 HERE WE TAKE CARE OF THE UGLY OVERFLOW MESS!
00019 00008 SUBROUTINES (WHICH USE PP INSTEAD OF P)
00022 00009 DATA STORAGE
00023 00010 ROUTINES TO PUSH AND POP ACCUMULATORS.
00025 ENDMK
⊗;
TITLE FATAL
INTERNAL FATAL.,WARN.,TRAPINIT,PUSHIT,POPIT,DDTGO,OVRGAG
EXTERNAL PDL
EXTERNAL JOBCNI,JOBAPR,JOBTPC,JOBREL,JOBHRL,JOBDDT
EXTERNAL JOBREN,JOBOPC,JOBSA
IFNDEF JENFIX<JENFIX←←0 > ;SET TO -1 WHEN INTJEN IS FIXED
OPDEF INTJEN [ 723B8 ]
OPDEF JRSTF [JRST 2,]
OPDEF GO[JRST]↔OPDEF LACI[MOVEI]
OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]
OPDEF CDR[HRRZ]↔OPDEF CAR[HLRZ]
OPDEF DAP[HRRM]↔OPDEF DIP[HRLM]
CNT←14
RA←15
PP←16
P←17
INTTTI←←4000000 ; INTERRUPT ON <ESC>I
CNS←←400000 ; INTERRUPT ON CONS TRAP
POV←←200000 ; INTERRHUPT ON PDL OV
ILM←←20000 ; INTERRUPT ON ILL. MEM. REF.
NXM←←10000 ; INTERRUPT ON NON-EX. MEM.
INTFOV←←100 ; INTERRUPT ON FOATING OVERFLOW
INTOV←←10 ; INTERRUPT ON ARITHMETIC ROVERFHLOW
OVBOTH←←INTOV+INTFOV
DEFINE INTFOR <FOR @` I ⊂ (INTTTI,POV,ILM,OVBOTH)>
;INITIALIZE APR TRAP
TRAPINIT:
;____________________________________________________________________
LACI 0,INTLOC↔DAC 0,JOBAPR
IFN JENFIX <POP P,INTPC↔INTJEN INTWRD>
IFE JENFIX <LAC 0,INTWRD↔INTENB 0,↔POPJ P,>
XWD 777000,[SIXBIT/WARN./]
WARN.: SETZM NOCONT↔GO FATAL2
XWD 777000,[SIXBIT/FATAL./]
FATAL.: SETOM NOCONT↔SETZM ALWAYS
FATAL2: SETOM ILOCK ;INTERLOCK AGAINST INTERRUPT
IFNDEF ERRUUO<POP P,INTPC>
DAC 0,ACSAVE ;SAVE STATE OF WORLD
LAC 0,[XWD 1,ACSAVE+1]
BLT ACSAVE+17
SKIPE NOCONT↔OUTSTR[ASCIZ/FATAL: /]
SKIPN NOCONT↔OUTSTR[ASCIZ/WARNING: /]
IFDEF ERRUUO
<LAC 0,40↔OUTSTR @0
LAC 0,ERRUU.↔DAC 0,INTPC>
IFNDEF ERRUUO
<LAC 0,@1(P)↔OUTSTR @0>
DAC 0,ERRTXT
SETZ 0,
INTENB ;TURN OFF OUR ENABLINGS
SETZM ILOCK ;RESET INTERLOCK, WE'RE SAFE NOW
LAC PP,[IOWD 10,BKPDL] ;GET A TEMPERARY PDL
GO BTRACE
;PRINT BACKTRACE
COMMENT ⊗
The following routine looks down the pushdown list for
something that looks like a PC word and prints out its name if it
has an NSUBR header, otherwise it prints its address in octal. It
finds out what routine was called by looking one or more back of the
return address on the PDL. Needless to say, it can be fooled by
routines that skip return or push funny PC words on the stack. ⊗
USERMODE←←1B5 ;ALWAYS ON IN A PC
PC.OFF←←1B4+1B6+37B17 ;ALWAYS OFF IN A PC
;1B4 is byte interrupt, never in user PDL
;1B6 is IOT mode, almost never on in PDL
BTRACE: CDR P,P ;GET READY TO PRINT A BACKTRACE
OUTSTR[ASCIZ/
BACKTRACE: /]
PCLOOP: LAC RA,(P) ;PICK UP WORD OFF OF STACK AND SEE IF IT'S A PC
TLNE RA,(USERMODE) ;IS USER MODE ON?
TLNE RA,(PC.OFF) ;AND OTHER DETERMI1NING BITS OFF?
GO NOTPC ;NO, NOT A PC
PUSH PP,RA ;LEFT HALF GOOD, NOW, IS IT IN OUR CORE IMAGE
PUSHJ PP,ADRCHK
GO NOTPC ;NO, PROBABLY NOT A PC
LACI CNT,3 ;DON'T LOOK MORE THAN THREE BACK
OUTSTR[ASCIZ/ /]
PJLOOP: SUBI RA,1
JUMPLE RA,UNKNPJ
CAR 0,(RA) ;LOOK FOR A PUSHJ
CAIN 0,(<PUSHJ P,>)
GO GOTPJ
SOJG CNT,PJLOOP
UNKNPJ: OUTSTR[ASCIZ/(?)/] ;WE DIDN'T FIND A PUSHJ, INDICATE AN UNKNOWN ROUTINE
GO NOTPC ;AND LOOK FOR MORE
GOTPJ: PUSH PP,(RA) ;WE FOUND A PUSHJ P,
PUSHJ PP,ADRCHK ;CHECK ADDRESS
GO UNKNPJ ;OOPS, PRINT BARF MESSAGE
LDB 0,[POINT 12,-1(1),11] ;LOOK BACK AT SUBROUTINE-1
CAIE 0,7770 ;IS SPECIAL MARK THERE?
GO [ LDB 0,[POINT 12,-1(1),11] ;NO, TRY BACK ANOTHER, IN CASE IT STARTS
CAIN 0,7770 ;AT SUBROUTINE+1
GO [ LAC 1,-2(1) ;SPECIAL MARK THERE
PUSH PP,(1) ;PRINT NAME+1
PUSHJ PP,SIXOUT
OUTSTR[ASCIZ/+1/]
GO NOTPC ]
PUSH PP,1 ;PRINT OCTAL OF SUBROUTINE ADDRESS
PUSHJ PP,OCTOUT
GO NOTPC ]
LAC 1,-1(1) ;PRINT NAME OF ROUTINE
PUSH PP,(1)
PUSHJ PP,SIXOUT
NOTPC: SOS P ;NOW, LETS TRY NEXT ONE DOWN
CAIL P,PDL ;END YET?
GO PCLOOP ;NO
OUTSTR[ASCIZ/
/] ;YES, CRLF
MOVSI 17,ACSAVE ;RESTORE ACS
BLT 17,16
SKIPE STAT6
SKIPN OVRGAG
GO CMLOOP ;WE COULD FALL THRU BUT THIS IS SAFER
OUTSTR[ASCIZ/(By the way, the PDP-6 is down.)
/]↔ SETZM STAT6
GO CMLOOP
;WHAT USER CAN DO ABOUT ERROR
;
CMLOOP: SKIPN NOCONT
GO [ SKIPE ALWAYS↔GO CONT
OUTSTR [ASCIZ/→/]
GO CMLOO2]
OUTSTR [ASCIZ/?/]
CMLOO2: CLRBFI ;NO TYPE AHEAD, THANK YOU
INCHRW 17↔ANDI 17,137 ;WHAT DOES USER WANT TO DO
CAIN 17,"R"↔GO @JOBREN
CAIN 17,"S"↔GO [ CDR 17,JOBSA↔GO (17) ]
CAIN 17,"D"↔GO DDTCALL
CAIN 17,"α"↔GO CONT
SKIPE NOCONT↔GO NOTCOM
CAIN 17,12
CAIE 17,15
GO [ CAIN 17,12↔SETOM ALWAYS
CONT: SETZM ILOCK↔GO INTRT2 ]
NOTCOM: OUTSTR[ASCIZ/???
D - DDT, R - REENTER, S - START/]
SKIP NOCONT
OUTSTR[ASCIZ/, <RETURN> CONTINUE
/]↔ OUTSTR[ASCIZ/
/]↔ OUTSTR @ERRTXT
GO CMLOOP
;SEE IT DDT IS LOADED AND RUN IT
DDTCALL:SKIPN 17,JOBDDT
GO [ OUTSTR[ASCIZ/
NO DDT.
?/]↔ GO CMLOOP ]
IFE JENFIX
< SETOM ILOCK ;WATCH THE RACE CONDITION
LAC 17,INTPC
DAC 17,JOBOPC
OUTSTR[ASCIZ/
YOU'RE IN DDT.
/]
LAC 17,INTWRD
INTENB 17,
LAC 17,ACSAVE+17
SETZM ILOCK ;WATCH THE RACE CONDITION
GO @JOBDDT
>
OUTSTR [ASCIZ/
YOU'RE IN DDT.
/]
IFN JENFIX
< LAC 17,ACSAVE+17
INTJEN INTWRD
>
;WE GET HERE ON AT INTERRUPT
;
INTLOC: SETZ ;TURN OFF INTERRUPTS, JUST IN CASE!
INTENB
DAC 5,STAT6 ;REMEMBER THE STATUS OF PDP-6
LAC 0,JOBCNI ;HOW DID WE GET HERE?
INTFOR
<IFE I∧777777 < TLNE 0,(I)
>IFN I∧777777 < TRNE 0,I
> GO [ LACI .`I
GO USRRET ]
>
LACI .UNKNOWN
USRRET: DAC PCGO
SKIPE ILOCK
GO ILOSE
UWAIT ;WHEN WE RETURN, WE'LL GET OUR AC'S BACK
DAC 0,ACSAVE
LAC 0,JOBTPC↔DAC 0,INTPC
LAC 0,[XWD 1,ACSAVE+1]
BLT 0,ACSAVE+17
DEBREAK
LAC PP,[IOWD 10,BKPDL]
JRSTF @PCGO
.POV: OUTSTR[ASCIZ/?
PDL OV/]
SOS INTPC ;INSTRUCTION WHERE IT REALLY HAPPENED
PUSHJ PP,ATUSER
GO IFATAL
.ILM: PUSH PP,INTPC
PUSHJ PP,ADRCHK
GO [ OUTSTR[ASCIZ/?
PC OUT OF BOUNDS/]
GO .ILM2 ]
;*** A PAGING ROUTINE COULD BE INCLUDED HERE ***
OUTSTR[ASCIZ/?
ILL MEM REF/]
.ILM2: PUSHJ PP,ATUSER
GO IFATAL
.INTTT: OUTSTR[ASCIZ/
<ESC> I INTERRUPT/]
PUSHJ PP,ATUSER
SETZM NOCONT
SETZM ALWAYS
GO BTRACE
.UNKNO: OUTSTR[ASCIZ/?
UNEXPECTED INTERRUPT/]
PUSHJ PP,ATUSER
GO IFATAL
IFATAL: SETOM NOCONT
SETZM ALWAYS
GO BTRACE
ILOSE: CAIN .INTTTI
GO [ LAC 0,INTWRD ;WE'RE ALREADY IN AN ERROR ROUTINE
INTENB 0,
DISMIS ]
LAC 0,JOBTPC
DAC 0,INTPC
UWAIT ;GET BACK USER ACS, ETC.
DEBREAK ;GET BACK TO USER LEVEL
OUTSTR[ASCIZ/?
INTERRUPT OCCURED DURING ERROR ROUTINE! /]
HALT .+1
JRSTF @INTPC
;HERE WE TAKE CARE OF THE UGLY OVERFLOW MESS!
;
.OVBOTH:LAC 0,INTPC
TLNE 0,000040 ;TEST ZERO DIVIDE
GO [ SKIPN OVRGAG ;DIVISION BY ZERO RESULTS IN INFINITY!
OUTSTR[ASCIZ/DIVISION BY ZERO/]
LAC 0,[377777777777]
GO FIXOVER ]
TLNE 0,000100 ;TEST FLOATING UNDERFLOW
GO [ SKIPN OVRGAG ;SET TO ZERO
OUTSTR[ASCIZ/FLOATING UNDERFLOW/]
SETZ 0,
GO FIXOVER ]
TLNE 0,040000
GO [ SKIPN OVRGAG
OUTSTR[ASCIZ/FLOATING OVERFLOW/]
LAC 0,[377777777777] ;FLOATING OVERFLOW PRODUCES INFINITY
GO FIXOVER ]
TLNN 0,400000 ;INTEGER OVERFLOW?
HALT .+1
MOVSI 1,400000
ANDCAM 1,INTPC
GO INTRET
FIXOVER:DAC 0,OVFIX
SKIPN OVRGAG
PUSHJ PP,ATUSER
MOVSI 1,440140 ;TURN OFF LOSING BITS
ANDCAB 1,INTPC
LAC 1,-1(1) ;IT HAPPENED AT PC-1
XCLOOP: LDB 2,[POINT 9,1,8] ;GET OPCODE
CAIN 2,<XCT>/1B8 ;IS IT AN XCT INSTRUCTION
GO [ TLZ 1,777400 ;TURN OFF OPCODE
TLO 1,(<LAC 1,>)
DAC 1,OVINST
MOVSI 17,ACSAVE ;YES, TRY NEXT ONE IN CHAIN
BLT 17,16
LAC 17,ACSAVE+17
XCT OVINST
GO XCLOOP ]
DAC 1,OVINST
TLZ 1,777740 ;TURN IT INTO A LACI TO CALCULATE EFFECTIVE ADDRESS
TLO 1,(<LACI 2,>)
DAC 1,OVOP
MOVSI 17,ACSAVE ;GET ACS FOR EFFECTIVE ADDRESS CALCULATION
BLT 17,16
LAC 17,ACSAVE+17
XCT OVOP ;DO ADDRESS CALCULATION, PUTTING RESULT INTO AC.2
CAIGE 2,17 ;IN CASE THE EFFECTIVE ADDRESS IN AN AC
ADDI 2,ACSAVE ;POINT TO SAVED ACS
LDB 3,[POINT 4,OVINST,12];GET AC FIELD INTO AC.3
ADDI 3,ACSAVE ;POINT TO SAVED ACS
LDB 1,[POINT 9,OVINST,8];GET OPCODE
LAC 0,OVFIX
CAIN 1,<FSC>/1B8 ;SPECIAL TEST FOR FSC
GO [ SETZ 1, ;RESULT INTO AC.0
GO NTEST2 ]
CAILE 1,140 ;IS IT FLOATING IMMEDIATE?
CAILE 1,177
GO NTEST ;NO, NOT FLOATING
ANDI 1,7
CAIE 1,5 ;ONLY IF LOWER ORDER DIGIT=5
GO NTEST
MOVSS 2,2
SKIPGE 2
MOVN 0,0
GO NTEST2
NTEST: ANDI 1,3 ;JUST MODE BITS, PLEASE
CAIN 1,1 ;DON'T TRY TO REFERENCE MEMORY ON IMMEDIATE, PLEASE
GO NTEST2
SKIPGE (2) ;CHANGE SIGN AS IF (MEMORY)<0
MOVN 0,0
NTEST2: SKIPGE (3) ;CHANGE SIGN IF (AC)<0
MOVN 0,0
SKIPN (3) ;MAKE 0/0=0
SETZ 0,
ANDI 1,3 ;JUST MODE BITS, PLEASE
TRNE 1,2 ;DOES RESULT GO TO MEMORY?
DAC 0,(2) ;YES
CAIE 1,2 ;JUST TO MEMORY?
DAC 0,(3) ;NO
INTRET: MOVSI 17,ACSAVE
BLT 17,16
INTRT2:
IFN JENFIX
< LAC 17,ACSAVE+17
INTJEN INTWRD
>
IFE JENFIX
< LAC 17,INTWRD
INTENB 17,
LAC 17,ACSAVE+17
JRSTF @INTPC
>
;SUBROUTINES (WHICH USE PP INSTEAD OF P)
;____________________________________________________________________
; Routine to check to make sure RH is in core image. Returns RH is 1
; and skips if legal address
ADRCHK: CDR 1,-1(PP)
CAMLE 1,JOBREL
GO [ CAIL 1,400000 ;(DON'T NEGLECT UPPER!)
CAILE 1,JOBHRL
GO POPP1J
GO .+1]
AOS (PP)
POPP1J: SUB PP,[XWD 2,2]
GO @2(PP)
;____________________________________________________________________
; Print a right half in octal (if called at OCTOUT+1, print left half)
OCTOUT: MOVSS -1(PP) ;LAC INTO LEFT HALF
SKIPA 4,[[ ROTC 3↔"0" ]] ;WE CAN SHARE CODE WITH SIXOUT
; Print a number in sixbit
SIXOUT: LACI 4,[ ROTC 6↔" "] ;(TO SHARE WITH OCTOUT)
LACI 3,6 ;NUMBER OF CHARACTERS
LAC 1,-1(PP) ;GET ARG.
SXLOOP: SETZ 0, ;CLEAR AC WERE ABOUT TO ROTC INTO
XCT (4) ;GET HIGH ORDER DIGIT/CHARACTER
ADD 0,1(4) ;ADD APPROPRIATE THING
OUTCHR 0 ;OUTPUT
CAIE 0," " ;TEST FOR END (FOR SIXBIT, THIS NEVER HAPPENS FOR OCTOUT)
SOJG 3,SXLOOP ;MORE TO COME
SUB PP,[XWD 2,2] ;WE'RE DONE, RETURN
JRSTF @2(PP)
;____________________________________________________________________
;PRINT ' AT USER 000000'
ATUSER: PUSH PP,0 ;SAVE AC 0
OUTSTR [ASCIZ/ AT USER /]
PUSH PP,INTPC
PUSHJ PP,OCTOUT
OUTSTR [ASCIZ/
/]
POP PP,0
POPJ PP,
;DATA STORAGE
ACSAVE: BLOCK 20
BKPDL: BLOCK 10
;INTWRD AND INTPC MUST BE IN ORDER OR INTJEN WILL LOSE!
.INTWRD←←0
INTFOR <.INTWRD←←.INTWRD!I
>
INTWRD: .INTWRD
INTPC: BLOCK 1
PCGO: BLOCK 1
ILOCK: BLOCK 1
STAT6: BLOCK 1
OVFIX: BLOCK 1
OVOP: BLOCK 1
OVINST: BLOCK 1
NOCONT: BLOCK 1
ALWAYS: BLOCK 1
OVRGAG: BLOCK 1
ERRTXT: BLOCK 1
;ROUTINES TO PUSH AND POP ACCUMULATORS.
IFNDEF PUSHIT <
↑↑PUSHIT:
PUSH P,0 ; SAVE 0
HLRE 0,P ; PICK UP COUNT
ADDI 0,20 ; ADD IN DISPLACEMENT
XOR 0,P ; IF SIGNS ARE DIFFERENT, NOT ENOUGH STACK
JUMPGE 0,PUSHOK
POP P,0 ; CAN'T DO IT, LOSE BIG
OUTSTR [ASCIZ ⊗NOT ENOUGH ROOM TO PUSH ACS!!
⊗]
SKIPN JOBDDT
GO [ OUTSTR[ASCIZ⊗YOU LOSE. ⊗]
HALT PUSHIT ]
↑↑DDTGO:OUTSTR[ASCIZ⊗YOU'RE IN DDT
⊗]
POP P,JOBOPC
GO @JOBDDT
PUSHOK: POP P,0 ; GET BACK 0
EXCH 0,(P) ;SAVE 0 AND GET RETURN.
DAC 0,20(P) ;GEE, THIS WAY WE RETURN WITH A POPJ
LACI 0,1(P)
HRLI 0,1
BLT 0,17(P)
ADD P,[XWD 20,20]
POPJ P, ;RETURN TO SENDER
↑↑POPIT:
MOVSI 0,-17(P)
HRRI 0,1
BLT 0,17
LAC 0,20(P)
EXCH 0,(P)
POPJ P,
>
END